Análisis y pronóstico de la información accidentalidad vehicular en el municipio de Medellín para los años 2014 a 2018

2.3.1. Limpieza y resumen de los datos

# se instalan los paquetes necesarios

#install.packages("tidyverse")    # dialecto de ciencia de datos
#install.packages("data.table")   # manejo de tablas
#install.packages("ggplot2")      # manejo de graficas
#install.packages("plotly")       # graficas semi-dinamicas
#install.packages("rmarkdown")    # utilizar rmarkdown
#install.packages("shiny")        # tableros de control dinamicos
#install.packages("prettydoc")    # dar formato a rmarkdown
#install.packages("sf")           # manejo de archivos espaciales (.shp)
#install.packages("leaflet")      # mapas dinamicos en HTML
#install.packages("rpart")        # pendiente
#install.packages("rpart.plot")   # pendiente

# cargar librerias
library(data.table)   # manejo de tablas
library(purrr)        # optimizacion de bucles
library(dplyr)        # manejo de tablas
library(plotly)       # graficos en html
library(tidyr)        # limpieza de datos
library(stringr)      # limpieza de texto
library(lubridate)    # limpieza de fechas
library(sf)           # manejo de archivos espaciales

De manera inicial se leen los archivos.

Nota al ejecutador de código: para algunos sistemas operativos o versiones de paquetes la limpieza no funciona correctamente, por lo que se recomienda volver a cargar el archivo a partir aquí.

# lista archivos
lista <- list.files(pattern = "^Acc.*.csv", include.dirs = T, recursive = T)

# leer todos los archivos
lista_df <- map(lista, fread, sep = ",", encoding = "UTF-8", colClasses = "c")

# agregar archivos del 2014 a 2018
acc <- bind_rows(lista_df)

# ver cabecera del archivo
head(acc)

Se identifica que se deben hacer las siguientes correcciones en la tabla acc:

• Organizar la columna FECHA en formato ISO 8601..

• Debido a la naturaleza del trabajo, se eliminan los nulos de la columna.

CLASE y se unifican los tipos de accidente, limpiando tildes y convirtiendo en mayúscula.

• De forma similar, se eliminan los nulos de la columna DISENO, se unifican los tipos de diseño, se limpian tildes y se convierte a mayúscula.

• Se eliminan las tildes de los días de la semana en la columna DIA_NOMBRE.

• Se crea la columna COMUNA_BARRIO a partir de la columna CBML con el objetivo de que sirva como clave foránea para la unión con el archivo espacial de barrios, disponible aquí.

# organizar fecha
acc$FECHA <- ymd(gsub(pattern = "T.*", replacement = "", acc$FECHA),
                  "%Y-%M-%D")[1:209426]

# eliminar datos nulos y corregir clase
acc <- acc[-which(acc$CLASE == ""),]
acc$CLASE <- iconv(acc$CLASE, from = "UTF-8", to = "ASCII//TRANSLIT")
acc$CLASE <- gsub("DE ", "", toupper(acc$CLASE))

# eliminar datos nulos y corregir disenio
acc <- acc[-which(acc$DISENO == ""),]
acc$DISENO <- iconv(acc$DISENO, from = "UTF-8", to = "ASCII//TRANSLIT")
acc$DISENO <- gsub("DE ", "", toupper(acc$DISENO))

# corregir tildes de DIA_NOMBRE
acc$DIA_NOMBRE <- iconv(acc$DIA_NOMBRE, from = "UTF-8", to = "ASCII//TRANSLIT")

# crear columna de comuna_barrio
acc <- mutate(acc, COMUNA_BARRIO = str_sub(CBML, 1, 4))

# visualizar nueva acc
head(acc)

Se procede a cargar el archivo espacial de barrios para identificar correctamente el barrio y la comuna de la ubicación del accidente. Luego, se realiza una nueva limpieza de la tabla acc: * Se limpian las tildes de la columna barrio y se convierte a mayúscula. * Se eliminan los registros duplicados generados por la unión. * Se eliminan algunas columnas no necesarias para el análisis. * Se renombran las columnas de NOMBRE_BAR y NOMBRE_COM por BARRIO y COMUNA respectivamente.

# cargar archivo shp de barrios de medellin
barrio <- read_sf("files/Limite_Barrio_Vereda_Catastral/Limite_Barrio_Vereda_Catastral.shp")

# unir columnas de nombre barrio y comuna
acc <- inner_join(acc, 
                  select(barrio, CODIGO, NOMBRE_COM, NOMBRE_BAR),
                  by = c("COMUNA_BARRIO" = "CODIGO"))
  
# limpiar nombre de barrios
acc$NOMBRE_BAR <- iconv(acc$NOMBRE_BAR, from = "UTF-8", to = "ASCII//TRANSLIT")
acc$NOMBRE_BAR <- toupper(acc$NOMBRE_BAR)

# eliminar posibles duplicados por errores de union
acc <- data.table:::unique.data.table(acc, by = "RADICADO")

# eliminar columnas
acc <- select(acc, -BARRIO, -COMUNA, -OBJECTID, -RADICADO, -DIRECCION_ENC,
              -DIRECCION, -HORA, -CBML, -TIPO_GEOCOD, -MES_NOMBRE, -geometry)

# renombrar
names(acc)[12:13] <- c("COMUNA","BARRIO")

# visualizar acc
head(acc)

Se realiza la lectura de la tabla de días especiales, se limpia y se realiza unión con la tabla de accidentes. * Se cambia las columnas tal que si es un día especial tenga la marcación Si, de lo contrario será No.

# lectura del archivo
festivos <- fread("files/festivos_y_especiales.csv", header = T)

# convertir a si o no
festivos[,names(festivos)[-1]] <- festivos %>%
                                  transmute_at(c(names(festivos)[-1]),
                                               funs(ifelse(. == "X",
                                                           "Si", 
                                                           ifelse(. == "",
                                                                  "No",
                                                                  .)
                                                           )
                                                    )
                                               )

# convetir a formato fecha
festivos$FECHA <- ymd(festivos$FECHA)[1:172]

# visualizar festivos
head(festivos)

Se realiza la unión de las tablas y se convierten los datos de los días especiales a No en caso de que no haya encontrado coincidencia en la unión.

# union de tablas
acc <- merge(x = acc, y = festivos, by = "FECHA", all.x = T)

# transformar variables
acc[,names(festivos)[-1]] <- acc %>%
                             transmute_at(c(names(festivos)[-1]),
                                         funs(ifelse(is.na(.),
                                                     "No",
                                                     .)
                                              )
                                         )

# visualizar acc
head(acc)

Se realiza la conversión a la codificación UTF-8 y se guarda el nuevo archivo.

# convertir a utf8
acc[,2:length(acc)] <- map(.x = acc[,2:length(acc)], .f = enc2utf8)

 # guardar archivo
fwrite(acc, "files/accidentalidad_georreferenciada_completa.csv", sep = ",")

# eliminar archivo y limpiar memoria
rm(acc)
gc(reset = T)

##           used (Mb) gc trigger  (Mb) max used (Mb)
## Ncells 1456730 77.8    2754562 147.2  1456730 77.8
## Vcells 8388610 64.1   31554028 240.8  8388610 64.1

# volver a cargar el archivo
acc <- fread("files/accidentalidad_georreferenciada_completa.csv",
             sep = ",",
             encoding = "UTF-8")

# organizar fecha
acc$FECHA <- ymd(acc$FECHA)

# visualizar
head(acc)

2.3.2. Análisis

Primero realizaremos un análisis descriptivo univariado de las variables por el número de accidentes registrados

acc_comuna <- acc %>% 
              group_by(COMUNA) %>% 
              summarize(total_registros = n())
ggplot(data=acc_comuna, aes(x=COMUNA, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = .8)+
    xlab("Comuna")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por comuna")+ #título del gráfico
    coord_flip()

acc_mes <- acc %>% 
              group_by(MES) %>% 
              summarize(total_registros = n())
p1 <- ggplot(data=acc_mes, aes(x=MES, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Mes")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por mes") #título del gráfico

p1

acc_nombredia <- acc %>% 
              group_by(DIA_NOMBRE) %>% 
              summarize(total_registros = n())
acc_nombredia$DIA_NOMBRE<-ordered(acc_nombredia$DIA_NOMBRE,levels=c( "LUNES", "MARTES", "MIERCOLES", "JUEVES", "VIERNES", "SABADO","DOMINGO"))

p2 <- ggplot(data=acc_nombredia, aes(x=DIA_NOMBRE, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Días")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por días de la semana") #título del gráfico

p2

acc_ano <- acc %>% 
              group_by(PERIODO) %>% 
              summarize(total_registros = n())
p3 <- ggplot(data=acc_ano, aes(x=PERIODO, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Año")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por año") #título del gráfico

p3

acc_clase <- acc %>% 
              group_by(CLASE) %>% 
              summarize(total_registros = n())
p4 <- ggplot(data=acc_clase, aes(x=CLASE, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Tipo de accidente")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por tipo de accidente") #título del gráfico

p4

acc_gravedad <- acc %>% 
              group_by(GRAVEDAD) %>% 
              summarize(total_registros = n())
ggplot(data=acc_gravedad, aes(x=GRAVEDAD, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Gravedad del accidente")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por gravedad del accidente") #título del gráfico

acc_diseno <- acc %>% 
              group_by(DISENO) %>% 
              summarize(total_registros = n())
ggplot(data=acc_diseno, aes(x=DISENO, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Diseño de la vía")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por tipo de vía")+ #título del gráfico
    coord_flip()

acc_group_clase<- acc %>% group_by(CLASE, GRAVEDAD) %>% summarize(conteo = n())

ggplot(data=acc_group_clase, aes(x=CLASE, y=conteo, fill=GRAVEDAD)) + 
    geom_bar(stat="identity", position="dodge")+
    coord_flip()

acc_group_mes<- acc %>% group_by(MES,CLASE) %>% summarize(conteo = n()) 
ggplot(data=acc_group_mes, aes(x=CLASE, y=conteo, fill=MES)) + 
    geom_bar(stat="identity", position="dodge")

acc_group_year<- acc %>% group_by(CLASE, PERIODO) %>% summarize(conteo = n()) 
ggplot(data=acc_group_year, aes(x=CLASE, y=conteo, fill=as.factor(PERIODO))) + 
    geom_bar(stat="identity", position="dodge")+
    scale_fill_manual(values=c("#d0d1e6", "#bdc9e1","#74a9cf","#2b8cbe","#045a8d"))

acc_group_dia<- acc %>% group_by(CLASE, DIA_NOMBRE) %>% summarize(conteo = n()) 

ggplot(data=acc_group_dia, aes(x=CLASE, y=conteo, fill=DIA_NOMBRE)) + 
    geom_bar(stat="identity", position="dodge")+
    scale_fill_manual(values=c("#67001f","#b2182b","#d6604d","#f4a582","#fddbc7","#d1e5f0", "#92c5de"))+
  coord_flip()

acc_group_festivo<- acc %>% group_by(CLASE, FESTIVO) %>% summarize(conteo = n()) 

ggplot(data=acc_group_festivo, aes(x=CLASE, y=conteo, fill=FESTIVO)) + 
    geom_bar(stat="identity", position="dodge")

acc_fecha <- acc %>% 
              group_by(FECHA) %>% 
              summarize(total_registros = n())

plot_ly (data=subset(acc_fecha,subset = (FECHA<="2018-12-31")),
         x = ~FECHA,
         y = ~total_registros,
         type = "scatter" ,mode = "lines",
         line=list(width=1,color='rgb(205, 12, 24)'))%>%
         layout(title='Registros de accidentalidad',
         xaxis=list(title="Día"),
         yaxis=list(title="Total registros"))

acc_fecha$year<-format(acc_fecha$FECHA,"%Y")
plot_ly (data=subset(acc_fecha,subset = (FECHA<="2018-12-31")),
         x = ~FECHA,
         y = ~total_registros,
         type = "scatter" ,mode = "lines",
         split = ~year,
         line=list(width=1))%>%
  layout(title='Registros de accidentalidad',
         xaxis=list(title="Día"),
         yaxis=list(title="Total registros"))

aggregate(total_registros~year,data=acc_fecha,FUN=mean)

acc_fecha$Fecha<-as.Date(acc_fecha$FECHA,"%d/%m/%Y")
acc_fecha$mes<-format(acc_fecha$Fecha,"%m")
with(acc_fecha, month.abb[mes])

##    [1] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [24] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [47] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [70] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [93] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [116] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [139] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [162] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [185] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [208] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [231] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [254] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [277] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [300] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [323] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [346] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [369] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [392] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [415] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [438] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [461] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [484] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [507] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [530] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [553] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [576] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [599] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [622] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [645] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [668] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [691] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [714] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [737] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [760] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [783] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [806] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [829] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [852] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [875] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [898] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [921] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [944] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [967] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [990] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1013] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1036] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1059] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1082] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1105] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1128] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1151] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1174] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1197] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1220] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1243] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1266] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1289] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1312] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1335] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1358] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1381] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1404] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1427] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1450] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1473] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1496] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1519] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1542] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1565] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1588] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1611] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1634] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1657] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1680] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1703] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1726] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1749] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1772] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1795] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1818] NA NA NA NA NA NA NA NA NA

acc_fecha$mes<-strftime(acc_fecha$Fecha, format = "%B")
acc_fecha$mes<-ordered(acc_fecha$mes,levels=c( "enero", "febrero", "marzo", 
"abril", "mayo", "junio","julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre"))
aggregate(total_registros~year*mes,data=acc_fecha,FUN=mean)%>%
  plot_ly(x = ~mes,
         y = ~total_registros,
         type = "scatter" ,mode = "lines",
         split = ~year,
         line=list(width=1))%>%
  layout(title='Promedio diario mensual de accidentes registrados',
         xaxis=list(title="Día"),
         yaxis=list(title="Total registros"))

plot_ly (data=subset(acc_fecha,subset = (Fecha<="2018-12-31")),
         x = ~year,
         y = ~total_registros,
         type = "box")%>%
  layout(title='Registros de accidentes',
         xaxis=list(title="Año"),
         yaxis=list(title="Total registros"))

acc_fecha$diames<-format(acc_fecha$Fecha,"%d")
plot_ly (data=subset(acc_fecha,subset = (Fecha<="2018-12-31")),
         x = ~mes,
         y = ~total_registros,
         type = "box")%>%
  layout(title='Registros de accidentes',
         xaxis=list(title="Mes"),
         yaxis=list(title="Total registros"))

acc_fecha$dia_semana<-weekdays(acc_fecha$Fecha)
acc_fecha$dia_semana<-ordered(acc_fecha$dia_semana,levels=c( "lunes", "martes", "miércoles", "jueves", "viernes", "sábado","domingo"))
plot_ly (data=subset(acc_fecha,subset = (Fecha<="2018-12-31")),
         x = ~dia_semana,
         y = ~total_registros,
         type = "box")%>%
  layout(title='Registros de accidentes',
         xaxis=list(title="Mes"),
         yaxis=list(title="Total registros"))

2.3.3. Datos atípicos o nulos

El manejo de datos nulos se dio en la sección 2.3.1. donde se tomaron las siguientes decisiones:

• Si CLASE era nulo, se eliminaba por la naturaleza del objetivo.
• Si DISENO era nulo, se eliminaba por la naturaleza del objetivo.
• Si COMUNA_BARRIO era nulo o no estaba en la tabla de barrios, se eliminaba ya que posiblemente corresponda a un dato difícil de medir.

Después de realizar el análisis, se concluye que ningún dato atípico será eliminado ya que corresponden a los datos de las tablas originales, a los cuales se les aplicaron transformaciones mínimas.

Regresar

Elección del modelo de regresión

Modelo grupo 0

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_0<-lm(ACCIDENTES~FECHA+CLASE+DISENO+DIA_NOMBRE+PERIODO+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_0, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_0)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DISENO + DIA_NOMBRE + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + BRUJITOS + SEMSANTA + 
##     ESCOLAR, data = acc_agrupado_0, subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -23.300  -6.657  -2.583   4.472  63.013 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          1.040e+03  5.886e+02   1.768 0.077120 .  
## FECHA                2.176e-03  7.966e-04   2.732 0.006304 ** 
## CLASECAIDA OCUPANTE -3.321e-01  2.841e-01  -1.169 0.242387    
## CLASECHOQUE          2.014e+01  2.508e-01  80.296  < 2e-16 ***
## CLASEINCENDIO       -9.749e+00  2.607e+00  -3.739 0.000185 ***
## CLASEOTRO            1.147e+00  2.814e-01   4.077 4.57e-05 ***
## CLASEVOLCAMIENTO    -5.297e+00  3.086e-01 -17.165  < 2e-16 ***
## DISENOGLORIETA      -4.280e+00  6.008e-01  -7.125 1.08e-12 ***
## DISENOINTERSECCION   9.001e+00  5.622e-01  16.011  < 2e-16 ***
## DISENOLOTE O PREDIO  6.244e+00  5.647e-01  11.057  < 2e-16 ***
## DISENOPASO A NIVEL  -5.699e+00  1.701e+00  -3.351 0.000808 ***
## DISENOPASO ELEVADO  -5.339e+00  7.015e-01  -7.611 2.86e-14 ***
## DISENOPASO INFERIOR -3.482e+00  8.257e-01  -4.217 2.48e-05 ***
## DISENOPONTON        -3.752e+00  2.581e+00  -1.454 0.146002    
## DISENOPUENTE        -5.320e+00  7.470e-01  -7.121 1.11e-12 ***
## DISENOTRAMO VIA      2.445e+01  5.506e-01  44.412  < 2e-16 ***
## DISENOTUNEL         -2.347e+00  2.653e+00  -0.885 0.376368    
## DISENOVIA PEATONAL   9.371e-01  1.756e+00   0.534 0.593660    
## DIA_NOMBREJUEVES     3.904e+00  3.139e-01  12.436  < 2e-16 ***
## DIA_NOMBRELUNES      3.618e+00  3.202e-01  11.299  < 2e-16 ***
## DIA_NOMBREMARTES     4.262e+00  3.143e-01  13.562  < 2e-16 ***
## DIA_NOMBREMIERCOLES  3.865e+00  3.152e-01  12.261  < 2e-16 ***
## DIA_NOMBRESABADO     3.258e+00  3.172e-01  10.271  < 2e-16 ***
## DIA_NOMBREVIERNES    4.386e+00  3.127e-01  14.027  < 2e-16 ***
## PERIODO             -5.409e-01  2.985e-01  -1.812 0.069971 .  
## FESTIVOSi           -2.828e+00  5.185e-01  -5.454 4.98e-08 ***
## MADRESi              1.414e+00  1.650e+00   0.857 0.391666    
## NAVIDADSi           -2.479e+00  8.407e-01  -2.949 0.003193 ** 
## BRUJITOSSi           5.316e-01  1.522e+00   0.349 0.726828    
## SEMSANTASi          -2.466e+00  6.244e-01  -3.949 7.87e-05 ***
## ESCOLARSi           -3.418e-01  6.907e-01  -0.495 0.620711    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.71 on 17203 degrees of freedom
## Multiple R-squared:  0.5463, Adjusted R-squared:  0.5455 
## F-statistic: 690.5 on 30 and 17203 DF,  p-value: < 2.2e-16

Modelo grupo 1

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+DIA+PERIODO+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + DIA + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + BRUJITOS + SEMSANTA + 
##     ESCOLAR, data = acc_agrupado_1, subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.136  -3.780  -0.428   4.098  52.536 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.393e+03  7.909e+02   3.026 0.002485 ** 
## FECHA                3.889e-03  1.064e-03   3.654 0.000260 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.450e-01  -3.382 0.000722 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.246  < 2e-16 ***
## CLASEINCENDIO       -1.028e+01  2.277e+00  -4.516 6.41e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.352 0.000806 ***
## CLASEVOLCAMIENTO    -7.471e+00  3.496e-01 -21.370  < 2e-16 ***
## DIA_NOMBREJUEVES     9.262e+00  4.130e-01  22.428  < 2e-16 ***
## DIA_NOMBRELUNES      8.485e+00  4.202e-01  20.191  < 2e-16 ***
## DIA_NOMBREMARTES     9.893e+00  4.144e-01  23.870  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.359e+00  4.127e-01  22.676  < 2e-16 ***
## DIA_NOMBRESABADO     7.739e+00  4.124e-01  18.768  < 2e-16 ***
## DIA_NOMBREVIERNES    1.038e+01  4.132e-01  25.117  < 2e-16 ***
## DIA                 -1.367e-02  1.266e-02  -1.080 0.279962    
## PERIODO             -1.218e+00  4.010e-01  -3.037 0.002396 ** 
## FESTIVOSi           -6.729e+00  6.740e-01  -9.984  < 2e-16 ***
## MADRESi              4.043e+00  2.107e+00   1.919 0.055026 .  
## NAVIDADSi           -7.228e+00  1.069e+00  -6.765 1.44e-11 ***
## BRUJITOSSi           1.673e+00  2.102e+00   0.796 0.426076    
## SEMSANTASi          -6.326e+00  8.072e-01  -7.837 5.28e-15 ***
## ESCOLARSi           -1.805e+00  9.617e-01  -1.877 0.060561 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.323 on 7225 degrees of freedom
## Multiple R-squared:  0.897,  Adjusted R-squared:  0.8967 
## F-statistic:  3145 on 20 and 7225 DF,  p-value: < 2.2e-16

Al verificar los valores P, se opta por retirar la variable BRUJITOS.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+DIA+PERIODO+FESTIVO+MADRE+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + DIA + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + SEMSANTA + ESCOLAR, 
##     data = acc_agrupado_1, subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.147  -3.778  -0.431   4.090  52.536 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.426e+03  7.898e+02   3.071 0.002141 ** 
## FECHA                3.934e-03  1.063e-03   3.701 0.000216 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.450e-01  -3.382 0.000722 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.251  < 2e-16 ***
## CLASEINCENDIO       -1.029e+01  2.277e+00  -4.517 6.36e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.352 0.000806 ***
## CLASEVOLCAMIENTO    -7.471e+00  3.496e-01 -21.370  < 2e-16 ***
## DIA_NOMBREJUEVES     9.262e+00  4.129e-01  22.429  < 2e-16 ***
## DIA_NOMBRELUNES      8.493e+00  4.201e-01  20.218  < 2e-16 ***
## DIA_NOMBREMARTES     9.901e+00  4.143e-01  23.897  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.359e+00  4.127e-01  22.677  < 2e-16 ***
## DIA_NOMBRESABADO     7.747e+00  4.122e-01  18.794  < 2e-16 ***
## DIA_NOMBREVIERNES    1.039e+01  4.130e-01  25.146  < 2e-16 ***
## DIA                 -1.282e-02  1.261e-02  -1.016 0.309497    
## PERIODO             -1.234e+00  4.004e-01  -3.082 0.002062 ** 
## FESTIVOSi           -6.732e+00  6.740e-01  -9.988  < 2e-16 ***
## MADRESi              4.050e+00  2.107e+00   1.922 0.054634 .  
## NAVIDADSi           -7.239e+00  1.068e+00  -6.775 1.34e-11 ***
## SEMSANTASi          -6.327e+00  8.072e-01  -7.839 5.20e-15 ***
## ESCOLARSi           -1.809e+00  9.617e-01  -1.882 0.059933 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.322 on 7226 degrees of freedom
## Multiple R-squared:  0.897,  Adjusted R-squared:  0.8967 
## F-statistic:  3310 on 19 and 7226 DF,  p-value: < 2.2e-16

No se observa nigun cambio en el R cuadrado ajustado. se opta por quitar DIA.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+MADRE+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + MADRE + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.261  -3.762  -0.431   4.105  52.692 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.347e+03  7.860e+02   2.986 0.002838 ** 
## FECHA                3.825e-03  1.057e-03   3.617 0.000300 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.450e-01  -3.382 0.000722 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.250  < 2e-16 ***
## CLASEINCENDIO       -1.028e+01  2.277e+00  -4.515 6.43e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.352 0.000807 ***
## CLASEVOLCAMIENTO    -7.471e+00  3.496e-01 -21.371  < 2e-16 ***
## DIA_NOMBREJUEVES     9.260e+00  4.129e-01  22.424  < 2e-16 ***
## DIA_NOMBRELUNES      8.485e+00  4.200e-01  20.203  < 2e-16 ***
## DIA_NOMBREMARTES     9.900e+00  4.143e-01  23.894  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.359e+00  4.127e-01  22.677  < 2e-16 ***
## DIA_NOMBRESABADO     7.749e+00  4.122e-01  18.798  < 2e-16 ***
## DIA_NOMBREVIERNES    1.038e+01  4.130e-01  25.143  < 2e-16 ***
## PERIODO             -1.194e+00  3.985e-01  -2.997 0.002735 ** 
## FESTIVOSi           -6.684e+00  6.723e-01  -9.941  < 2e-16 ***
## MADRESi              4.108e+00  2.106e+00   1.951 0.051131 .  
## NAVIDADSi           -7.283e+00  1.068e+00  -6.822 9.68e-12 ***
## SEMSANTASi          -6.341e+00  8.071e-01  -7.857 4.49e-15 ***
## ESCOLARSi           -1.715e+00  9.572e-01  -1.792 0.073162 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.322 on 7227 degrees of freedom
## Multiple R-squared:  0.8969, Adjusted R-squared:  0.8967 
## F-statistic:  3494 on 18 and 7227 DF,  p-value: < 2.2e-16

No se observa nigun cambio en el R cuadrado ajustado. se opta por quitar MADRE.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.249  -3.763  -0.433   4.122  52.693 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.308e+03  7.859e+02   2.937 0.003328 ** 
## FECHA                3.770e-03  1.057e-03   3.566 0.000365 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.451e-01  -3.382 0.000725 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.213  < 2e-16 ***
## CLASEINCENDIO       -1.029e+01  2.278e+00  -4.518 6.34e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.351 0.000809 ***
## CLASEVOLCAMIENTO    -7.470e+00  3.496e-01 -21.364  < 2e-16 ***
## DIA_NOMBREJUEVES     9.180e+00  4.110e-01  22.337  < 2e-16 ***
## DIA_NOMBRELUNES      8.406e+00  4.181e-01  20.105  < 2e-16 ***
## DIA_NOMBREMARTES     9.819e+00  4.123e-01  23.814  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.279e+00  4.108e-01  22.590  < 2e-16 ***
## DIA_NOMBRESABADO     7.669e+00  4.103e-01  18.693  < 2e-16 ***
## DIA_NOMBREVIERNES    1.030e+01  4.110e-01  25.069  < 2e-16 ***
## PERIODO             -1.175e+00  3.985e-01  -2.948 0.003212 ** 
## FESTIVOSi           -6.691e+00  6.724e-01  -9.951  < 2e-16 ***
## NAVIDADSi           -7.299e+00  1.068e+00  -6.836 8.82e-12 ***
## SEMSANTASi          -6.358e+00  8.072e-01  -7.877 3.83e-15 ***
## ESCOLARSi           -1.711e+00  9.574e-01  -1.787 0.074014 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.324 on 7228 degrees of freedom
## Multiple R-squared:  0.8969, Adjusted R-squared:  0.8966 
## F-statistic:  3698 on 17 and 7228 DF,  p-value: < 2.2e-16

No se observa nigun cambio en el R cuadrado ajustado. se opta por quitar ESCOLAR.

modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA, data = acc_agrupado_1, subset = (FECHA <= 
##     "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.242  -3.769  -0.465   4.134  52.735 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.158e+03  7.815e+02   2.761 0.005778 ** 
## FECHA                3.561e-03  1.051e-03   3.389 0.000706 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.452e-01  -3.381 0.000726 ***
## CLASECHOQUE          6.563e+01  3.451e-01 190.185  < 2e-16 ***
## CLASEINCENDIO       -1.027e+01  2.278e+00  -4.507 6.67e-06 ***
## CLASEOTRO            1.156e+00  3.451e-01   3.351 0.000810 ***
## CLASEVOLCAMIENTO    -7.468e+00  3.497e-01 -21.356  < 2e-16 ***
## DIA_NOMBREJUEVES     9.150e+00  4.107e-01  22.279  < 2e-16 ***
## DIA_NOMBRELUNES      8.370e+00  4.177e-01  20.039  < 2e-16 ***
## DIA_NOMBREMARTES     9.787e+00  4.120e-01  23.755  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.247e+00  4.104e-01  22.530  < 2e-16 ***
## DIA_NOMBRESABADO     7.670e+00  4.103e-01  18.693  < 2e-16 ***
## DIA_NOMBREVIERNES    1.027e+01  4.107e-01  25.010  < 2e-16 ***
## PERIODO             -1.098e+00  3.962e-01  -2.772 0.005588 ** 
## FESTIVOSi           -6.660e+00  6.723e-01  -9.906  < 2e-16 ***
## NAVIDADSi           -7.259e+00  1.068e+00  -6.799 1.13e-11 ***
## SEMSANTASi          -6.352e+00  8.073e-01  -7.869 4.11e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.326 on 7229 degrees of freedom
## Multiple R-squared:  0.8968, Adjusted R-squared:  0.8966 
## F-statistic:  3928 on 16 and 7229 DF,  p-value: < 2.2e-16

Dado que al quitar la variable anterior el R cuadrado ajustado bajo 0.0001, por lo cual se opta por dejar el modelo con la variable ESCOLAR.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.249  -3.763  -0.433   4.122  52.693 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.308e+03  7.859e+02   2.937 0.003328 ** 
## FECHA                3.770e-03  1.057e-03   3.566 0.000365 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.451e-01  -3.382 0.000725 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.213  < 2e-16 ***
## CLASEINCENDIO       -1.029e+01  2.278e+00  -4.518 6.34e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.351 0.000809 ***
## CLASEVOLCAMIENTO    -7.470e+00  3.496e-01 -21.364  < 2e-16 ***
## DIA_NOMBREJUEVES     9.180e+00  4.110e-01  22.337  < 2e-16 ***
## DIA_NOMBRELUNES      8.406e+00  4.181e-01  20.105  < 2e-16 ***
## DIA_NOMBREMARTES     9.819e+00  4.123e-01  23.814  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.279e+00  4.108e-01  22.590  < 2e-16 ***
## DIA_NOMBRESABADO     7.669e+00  4.103e-01  18.693  < 2e-16 ***
## DIA_NOMBREVIERNES    1.030e+01  4.110e-01  25.069  < 2e-16 ***
## PERIODO             -1.175e+00  3.985e-01  -2.948 0.003212 ** 
## FESTIVOSi           -6.691e+00  6.724e-01  -9.951  < 2e-16 ***
## NAVIDADSi           -7.299e+00  1.068e+00  -6.836 8.82e-12 ***
## SEMSANTASi          -6.358e+00  8.072e-01  -7.877 3.83e-15 ***
## ESCOLARSi           -1.711e+00  9.574e-01  -1.787 0.074014 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.324 on 7228 degrees of freedom
## Multiple R-squared:  0.8969, Adjusted R-squared:  0.8966 
## F-statistic:  3698 on 17 and 7228 DF,  p-value: < 2.2e-16

Se evalúa el agrupado 2 para determinar si este tiene un mejor ajuste.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_2<-lm(ACCIDENTES~FECHA+DIA_NOMBRE+PERIODO+CLASE+MES+DIA+COMUNA+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_2, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_2)

## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + DIA_NOMBRE + PERIODO + CLASE + 
##     MES + DIA + COMUNA + FESTIVO + MADRE + NAVIDAD + BRUJITOS + 
##     SEMSANTA + ESCOLAR, data = acc_agrupado_2, subset = (FECHA <= 
##     "2017-12-31"))
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -7.906 -1.658 -0.210  1.170 35.549 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                -3.050e+04  1.252e+04  -2.436 0.014840 *  
## FECHA                      -4.232e-02  1.739e-02  -2.434 0.014936 *  
## DIA_NOMBREJUEVES            8.658e-01  4.405e-02  19.657  < 2e-16 ***
## DIA_NOMBRELUNES             8.187e-01  4.477e-02  18.285  < 2e-16 ***
## DIA_NOMBREMARTES            9.247e-01  4.417e-02  20.936  < 2e-16 ***
## DIA_NOMBREMIERCOLES         8.776e-01  4.406e-02  19.918  < 2e-16 ***
## DIA_NOMBRESABADO            7.072e-01  4.401e-02  16.068  < 2e-16 ***
## DIA_NOMBREVIERNES           1.010e+00  4.405e-02  22.936  < 2e-16 ***
## PERIODO                     1.548e+01  6.354e+00   2.436 0.014846 *  
## CLASECAIDA OCUPANTE        -1.801e-01  3.857e-02  -4.670 3.02e-06 ***
## CLASECHOQUE                 3.896e+00  3.292e-02 118.364  < 2e-16 ***
## CLASEINCENDIO              -1.104e+00  6.777e-01  -1.629 0.103225    
## CLASEOTRO                  -8.732e-02  3.742e-02  -2.333 0.019639 *  
## CLASEVOLCAMIENTO           -6.746e-01  4.952e-02 -13.623  < 2e-16 ***
## MES                         1.300e+00  5.293e-01   2.455 0.014085 *  
## DIA                         4.131e-02  1.740e-02   2.374 0.017611 *  
## COMUNAARANJUEZ              1.645e+00  1.499e-01  10.977  < 2e-16 ***
## COMUNABELEN                 2.018e+00  1.503e-01  13.430  < 2e-16 ***
## COMUNABUENOS AIRES          9.004e-01  1.514e-01   5.945 2.77e-09 ***
## COMUNACASTILLA              2.925e+00  1.490e-01  19.629  < 2e-16 ***
## COMUNADOCE DE OCTUBRE       7.325e-01  1.519e-01   4.823 1.42e-06 ***
## COMUNAEL POBLADO            2.974e+00  1.515e-01  19.640  < 2e-16 ***
## COMUNAGUAYABAL              2.303e+00  1.504e-01  15.307  < 2e-16 ***
## COMUNALA AMERICA            7.047e-01  1.529e-01   4.609 4.05e-06 ***
## COMUNALA CANDELARIA         5.855e+00  1.483e-01  39.493  < 2e-16 ***
## COMUNALAURELES              3.665e+00  1.495e-01  24.513  < 2e-16 ***
## COMUNAMANRIQUE              7.541e-01  1.517e-01   4.973 6.61e-07 ***
## COMUNAPALMITAS             -1.431e+00  9.416e-01  -1.520 0.128463    
## COMUNAPOPULAR               4.487e-01  1.570e-01   2.858 0.004264 ** 
## COMUNAROBLEDO               1.833e+00  1.495e-01  12.262  < 2e-16 ***
## COMUNASAN ANTONIO DE PRADO -3.302e-01  1.690e-01  -1.953 0.050783 .  
## COMUNASAN CRISTOBAL         1.195e-01  1.621e-01   0.737 0.461059    
## COMUNASAN JAVIER            3.406e-01  1.548e-01   2.200 0.027795 *  
## COMUNASANTA CRUZ            1.187e-01  1.582e-01   0.751 0.452747    
## COMUNASANTA ELENA           1.452e-01  1.835e-01   0.791 0.429023    
## COMUNAVILLA HERMOSA         5.328e-01  1.528e-01   3.488 0.000488 ***
## FESTIVOSi                  -6.547e-01  7.309e-02  -8.956  < 2e-16 ***
## MADRESi                     4.205e-01  2.236e-01   1.881 0.060009 .  
## NAVIDADSi                  -5.505e-01  1.145e-01  -4.806 1.54e-06 ***
## BRUJITOSSi                  6.275e-02  2.117e-01   0.296 0.766923    
## SEMSANTASi                 -5.307e-01  9.041e-02  -5.870 4.38e-09 ***
## ESCOLARSi                  -1.328e-01  1.017e-01  -1.306 0.191710    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.791 on 58670 degrees of freedom
## Multiple R-squared:  0.4389, Adjusted R-squared:  0.4385 
## F-statistic:  1119 on 41 and 58670 DF,  p-value: < 2.2e-16

Agregando la variable de comunas, vemos que el modelo es menos significativo que e agrupado 1 por lo que se opta por hacer la validacion con el modelo del agrupado 1.

Calculo de \(R^2\) Manual de la regresion para comprobar con el función

y0_tr<-mean(acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"])
r0_tr<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y0_tr
R0_tr<-mean(r0_tr^2)
y_pred_tr_lm<-predict(modelo_lm_1)
r_tr_lm<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y_pred_tr_lm
R_tr_lm<-mean(r_tr_lm^2)
R2_lm<-1-R_tr_lm/R0_tr

print(R2_lm)

## [1] 0.8968859

este da igual.

se procede a hacer un ajuste del modelo Poisson, para esto de calcula un Pseudo \(R^2\)

# ERROR DE AQUI EN ADELANTE
#y_pred_tr_glm<-predict(modelo_glm,type="response")
#r_tr_glm<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y_pred_tr_glm
#R_tr_glm<-mean(r_tr_glm^2)
#R2_tr_glm<-1-R_tr_glm/R0_tr
#print(R2_tr_glm)

Este modelo muestra un \(R^2\) superior por lo cuál se usará para hacer las comparaciones de modelos.

Se elabora un DataFrame para poder graficar predichos y observados de los modelos

# resultados_lm_glm<-data.frame(FECHA=  acc_agrupado_1$FECHA[acc_agrupado_1$FECHA<="2017-12-31"],ACCIDENTES=acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"],
#                               pred_lm=y_pred_tr_lm,
#                               pred_glm=y_pred_tr_glm,
#                             res_lm=r_tr_lm,
#                             res_glm=r_tr_glm)

Modelo Arboles Decision BASE 0

library(rpart)
modelo_rpart_0<-rpart(ACCIDENTES~FECHA+CLASE+DISENO+DIA_NOMBRE+PERIODO+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_0, subset = (FECHA<="2017-12-31"))
print(modelo_rpart_0)

## n= 17234 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 17234 4348807.0000  9.720436  
##    2) DISENO=CICLO RUTA,GLORIETA,INTERSECCION,LOTE O PREDIO,PASO A NIVEL,PASO ELEVADO,PASO INFERIOR,PONTON,PUENTE,TUNEL,VIA PEATONAL 10055  313852.9000  3.975435  
##      4) DISENO=CICLO RUTA,GLORIETA,LOTE O PREDIO,PASO A NIVEL,PASO ELEVADO,PASO INFERIOR,PONTON,PUENTE,TUNEL,VIA PEATONAL 6588   22438.6900  2.202186 *
##      5) DISENO=INTERSECCION 3467  231335.4000  7.344967  
##       10) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 2007     906.8919  1.368211 *
##       11) CLASE=CHOQUE 1460   60181.5700 15.560960 *
##    3) DISENO=TRAMO VIA 7179 3238273.0000 17.766960  
##      6) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 5718  128893.2000  7.956628 *
##      7) CLASE=CHOQUE 1461  405264.6000 56.162220  
##       14) DIA_NOMBRE=DOMINGO 209   11492.4500 32.086120 *
##       15) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 1252  252399.8000 60.181310 *

library(rpart.plot)
rpart.plot(modelo_rpart_0,tweak = 1.2)

summary(modelo_rpart_0)

## Call:
## rpart(formula = ACCIDENTES ~ FECHA + CLASE + DISENO + DIA_NOMBRE + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + BRUJITOS + SEMSANTA + 
##     ESCOLAR, data = acc_agrupado_0, subset = (FECHA <= "2017-12-31"))
##   n= 17234 
## 
##           CP nsplit rel error    xerror        xstd
## 1 0.40250076      0 1.0000000 1.0000898 0.023939585
## 2 0.03250829      2 0.1949985 0.1950803 0.004253889
## 3 0.02648149      3 0.1624902 0.1626445 0.003648641
## 4 0.01000000      5 0.1095272 0.1097320 0.003142637
## 
## Variable importance
##      CLASE     DISENO DIA_NOMBRE 
##         74         22          4 
## 
## Node number 1: 17234 observations,    complexity param=0.4025008
##   mean=9.720436, MSE=252.3388 
##   left son=2 (10055 obs) right son=3 (7179 obs)
##   Primary splits:
##       DISENO     splits as  LLLLLLLLLRLL, improve=0.183195300, (0 missing)
##       CLASE      splits as  LLRLLL,       improve=0.136632500, (0 missing)
##       FECHA      < 17163.5 to the right,  improve=0.006059356, (0 missing)
##       PERIODO    < 2016.5  to the right,  improve=0.005957862, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,      improve=0.003779356, (0 missing)
##   Surrogate splits:
##       CLASE splits as  LRLRRR,      agree=0.628, adj=0.106, (0 split)
##       FECHA < 16141.5 to the right, agree=0.590, adj=0.016, (0 split)
## 
## Node number 2: 10055 observations,    complexity param=0.02648149
##   mean=3.975435, MSE=31.21362 
##   left son=4 (6588 obs) right son=5 (3467 obs)
##   Primary splits:
##       DISENO     splits as  LLRLLLLLL-LL, improve=0.191423500, (0 missing)
##       CLASE      splits as  LLRLLL,       improve=0.133986000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,      improve=0.002791311, (0 missing)
##       FECHA      < 17360.5 to the left,   improve=0.001973797, (0 missing)
##       PERIODO    < 2016.5  to the left,   improve=0.001427046, (0 missing)
##   Surrogate splits:
##       CLASE splits as  RLLLLL,      agree=0.668, adj=0.037, (0 split)
##       FECHA < 16076.5 to the right, agree=0.656, adj=0.001, (0 split)
## 
## Node number 3: 7179 observations,    complexity param=0.4025008
##   mean=17.76696, MSE=451.0758 
##   left son=6 (5718 obs) right son=7 (1461 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL,      improve=0.835048600, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.012244590, (0 missing)
##       FECHA      < 17158.5 to the right, improve=0.004915123, (0 missing)
##       PERIODO    < 2016.5  to the right, improve=0.004789309, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.001704451, (0 missing)
## 
## Node number 4: 6588 observations
##   mean=2.202186, MSE=3.405994 
## 
## Node number 5: 3467 observations,    complexity param=0.02648149
##   mean=7.344967, MSE=66.72496 
##   left son=10 (2007 obs) right son=11 (1460 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL,      improve=0.7359312000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.0082500230, (0 missing)
##       FECHA      < 17179.5 to the left,  improve=0.0055151280, (0 missing)
##       PERIODO    < 2016.5  to the left,  improve=0.0048665460, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.0007121953, (0 missing)
##   Surrogate splits:
##       FECHA < 16165.5 to the right, agree=0.589, adj=0.023, (0 split)
## 
## Node number 6: 5718 observations
##   mean=7.956628, MSE=22.54167 
## 
## Node number 7: 1461 observations,    complexity param=0.03250829
##   mean=56.16222, MSE=277.3885 
##   left son=14 (209 obs) right son=15 (1252 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.34883940, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.03986503, (0 missing)
##       FECHA      < 17158.5 to the right, improve=0.03572912, (0 missing)
##       PERIODO    < 2016.5  to the right, improve=0.03277970, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.02784668, (0 missing)
##   Surrogate splits:
##       MADRE splits as  RL, agree=0.86, adj=0.019, (0 split)
## 
## Node number 10: 2007 observations
##   mean=1.368211, MSE=0.4518644 
## 
## Node number 11: 1460 observations
##   mean=15.56096, MSE=41.22026 
## 
## Node number 14: 209 observations
##   mean=32.08612, MSE=54.9878 
## 
## Node number 15: 1252 observations
##   mean=60.18131, MSE=201.5973

y0_tr<-mean(acc_agrupado_0$ACCIDENTES[acc_agrupado_0$FECHA<="2017-12-31"])
r0_tr<-acc_agrupado_0$ACCIDENTES[acc_agrupado_0$FECHA<="2017-12-31"]-y0_tr
R0_tr<-mean(r0_tr^2)

y_pred_tr_rpart<-predict(modelo_rpart_0)
r_tr_rpart<-acc_agrupado_0$ACCIDENTES[acc_agrupado_0$FECHA<="2017-12-31"]-y_pred_tr_rpart
R_tr_rpart<-mean(r_tr_rpart^2)
R2_tr_rpart<-1-R_tr_rpart/R0_tr
print(R2_tr_rpart)

## [1] 0.8904728

Modelo Arboles Decision BASE 1

library(rpart)
modelo_rpart_1<-rpart(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
print(modelo_rpart_1)

## n= 7246 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
## 1) root 7246 6094251.0 23.119240  
##   2) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 5785  155757.7  9.521175 *
##   3) CLASE=CHOQUE 1461  633246.9 76.962350  
##     6) DIA_NOMBRE=DOMINGO 209   16374.4 45.306220 *
##     7) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 1252  372468.7 82.246810 *

library(rpart.plot)
rpart.plot(modelo_rpart_1,tweak = 1.2)

summary(modelo_rpart_1)

## Call:
## rpart(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
##   n= 7246 
## 
##           CP nsplit  rel error     xerror       xstd
## 1 0.87053297      0 1.00000000 1.00020840 0.02178205
## 2 0.04010399      1 0.12946703 0.12967599 0.00423566
## 3 0.01000000      2 0.08936304 0.08945901 0.00350991
## 
## Variable importance
##      CLASE DIA_NOMBRE 
##         96          4 
## 
## Node number 1: 7246 observations,    complexity param=0.870533
##   mean=23.11924, MSE=841.0504 
##   left son=2 (5785 obs) right son=3 (1461 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL,  improve=0.8705330000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.0113070000, (0 missing)
##       FESTIVO    splits as  RL,      improve=0.0014065900, (0 missing)
##       SEMSANTA   splits as  RL,      improve=0.0008808344, (0 missing)
##       NAVIDAD    splits as  RL,      improve=0.0006652363, (0 missing)
## 
## Node number 2: 5785 observations
##   mean=9.521175, MSE=26.9244 
## 
## Node number 3: 1461 observations,    complexity param=0.04010399
##   mean=76.96235, MSE=433.4339 
##   left son=6 (209 obs) right son=7 (1252 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.38595340, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.04166331, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.03167520, (0 missing)
##       SEMSANTA   splits as  RL,          improve=0.02596220, (0 missing)
##       FECHA      < 16530.5 to the left,  improve=0.01585194, (0 missing)
## 
## Node number 6: 209 observations
##   mean=45.30622, MSE=78.34642 
## 
## Node number 7: 1252 observations
##   mean=82.24681, MSE=297.499

y0_tr_1<-mean(acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"])
r0_tr_1<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y0_tr_1
R0_tr_1<-mean(r0_tr_1^2)

y_pred_tr_rpart_1<-predict(modelo_rpart_1)
r_tr_rpart_1<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y_pred_tr_rpart_1
R_tr_rpart_1<-mean(r_tr_rpart_1^2)
R2_tr_rpart_1<-1-R_tr_rpart_1/R0_tr_1
print(R2_tr_rpart_1)

## [1] 0.910637

Modelo Arboles Decision BASE 2

library(rpart)
modelo_rpart_2<-rpart(ACCIDENTES~FECHA+DIA_NOMBRE+PERIODO+CLASE+MES+DIA+COMUNA+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_2, subset = (FECHA<="2017-12-31"))
print(modelo_rpart_2)

## n= 58712 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 58712 814606.200  2.853284  
##    2) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 37168  26909.850  1.481920 *
##    3) CLASE=CHOQUE 21544 597205.000  5.219179  
##      6) COMUNA=ALTAVISTA,ARANJUEZ,BELEN,BUENOS AIRES,CASTILLA,DOCE DE OCTUBRE,EL POBLADO,GUAYABAL,LA AMERICA,MANRIQUE,PALMITAS,POPULAR,ROBLEDO,SAN ANTONIO DE PRADO,SAN CRISTOBAL,SAN JAVIER,SANTA CRUZ,SANTA ELENA,VILLA HERMOSA 18628 182724.100  3.845287  
##       12) COMUNA=ALTAVISTA,BUENOS AIRES,DOCE DE OCTUBRE,LA AMERICA,MANRIQUE,PALMITAS,POPULAR,SAN ANTONIO DE PRADO,SAN CRISTOBAL,SAN JAVIER,SANTA CRUZ,SANTA ELENA,VILLA HERMOSA 9998  16320.380  2.007902 *
##       13) COMUNA=ARANJUEZ,BELEN,CASTILLA,EL POBLADO,GUAYABAL,ROBLEDO 8630  93547.130  5.973928  
##         26) COMUNA=ARANJUEZ,BELEN,ROBLEDO 4311  25175.230  4.709116 *
##         27) COMUNA=CASTILLA,EL POBLADO,GUAYABAL 4319  54591.640  7.236397  
##           54) DIA_NOMBRE=DOMINGO 588   2936.223  3.743197 *
##           55) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 3731  43349.600  7.786920 *
##      7) COMUNA=LA CANDELARIA,LAURELES 2916 154698.000 13.995880  
##       14) COMUNA=LAURELES 1456  28420.440 10.049450 *
##       15) COMUNA=LA CANDELARIA 1460  80987.150 17.931510  
##         30) DIA_NOMBRE=DOMINGO 209   1656.421  7.052632 *
##         31) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 1251  50463.190 19.749000 *

library(rpart.plot)
rpart.plot(modelo_rpart_2,tweak = 1.5)

summary(modelo_rpart_2)

## Call:
## rpart(formula = ACCIDENTES ~ FECHA + DIA_NOMBRE + PERIODO + CLASE + 
##     MES + DIA + COMUNA + FESTIVO + MADRE + NAVIDAD + BRUJITOS + 
##     SEMSANTA + ESCOLAR, data = acc_agrupado_2, subset = (FECHA <= 
##     "2017-12-31"))
##   n= 58712 
## 
##           CP nsplit rel error    xerror        xstd
## 1 0.27637543      0 1.0000000 1.0000578 0.017705582
## 2 0.08943783      2 0.4472491 0.4473821 0.006537582
## 3 0.05559786      3 0.3578113 0.3579140 0.006036272
## 4 0.03543742      4 0.3022135 0.3024034 0.004904589
## 5 0.01691647      5 0.2667760 0.2669396 0.004204121
## 6 0.01019611      6 0.2498596 0.2503943 0.004044814
## 7 0.01000000      7 0.2396634 0.2437977 0.003999149
## 
## Variable importance
##     COMUNA      CLASE DIA_NOMBRE 
##         63         31          6 
## 
## Node number 1: 58712 observations,    complexity param=0.2763754
##   mean=2.853284, MSE=13.87461 
##   left son=2 (37168 obs) right son=3 (21544 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL, improve=0.2338447000, (0 missing)
##       COMUNA     splits as  LLLLRLRLLRRLLLLLLLLLL, improve=0.1100771000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.0075000810, (0 missing)
##       FESTIVO    splits as  RL, improve=0.0008081853, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.0005013052, (0 missing)
##   Surrogate splits:
##       COMUNA splits as  LLLLLLLLLLLLRLLRLLLLL, agree=0.635, adj=0.004, (0 split)
## 
## Node number 2: 37168 observations
##   mean=1.48192, MSE=0.7240059 
## 
## Node number 3: 21544 observations,    complexity param=0.2763754
##   mean=5.219179, MSE=27.72025 
##   left son=6 (18628 obs) right son=7 (2916 obs)
##   Primary splits:
##       COMUNA     splits as  LLLLLLLLLRRLLLLLLLLLL, improve=0.434998000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.025360560, (0 missing)
##       FESTIVO    splits as  RL, improve=0.002541788, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.001896749, (0 missing)
##       MES        < 1.5     to the left,  improve=0.001536040, (0 missing)
## 
## Node number 6: 18628 observations,    complexity param=0.08943783
##   mean=3.845287, MSE=9.809111 
##   left son=12 (9998 obs) right son=13 (8630 obs)
##   Primary splits:
##       COMUNA     splits as  LRRLRLRRL--LLLRLLLLLL, improve=0.398724600, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.022372320, (0 missing)
##       FESTIVO    splits as  RL, improve=0.001975984, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.001847804, (0 missing)
##       MES        < 1.5     to the left,  improve=0.001577436, (0 missing)
##   Surrogate splits:
##       FECHA < 16078.5 to the right, agree=0.537, adj=0.001, (0 split)
## 
## Node number 7: 2916 observations,    complexity param=0.05559786
##   mean=13.99588, MSE=53.05142 
##   left son=14 (1456 obs) right son=15 (1460 obs)
##   Primary splits:
##       COMUNA     splits as  ---------RL----------, improve=0.29276640, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.19844830, (0 missing)
##       FESTIVO    splits as  RL, improve=0.02333334, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.01432906, (0 missing)
##       MES        < 1.5     to the left,  improve=0.01236593, (0 missing)
##   Surrogate splits:
##       DIA_NOMBRE splits as  RRRRRRL, agree=0.501, adj=0.001, (0 split)
##       SEMSANTA   splits as  RL,      agree=0.501, adj=0.001, (0 split)
## 
## Node number 12: 9998 observations
##   mean=2.007902, MSE=1.632364 
## 
## Node number 13: 8630 observations,    complexity param=0.01691647
##   mean=5.973928, MSE=10.83976 
##   left son=26 (4311 obs) right son=27 (4319 obs)
##   Primary splits:
##       COMUNA     splits as  -LL-R-RR------L------, improve=0.147308200, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.083031400, (0 missing)
##       FESTIVO    splits as  RL, improve=0.008177895, (0 missing)
##       MES        < 1.5     to the left,  improve=0.006373795, (0 missing)
##       FECHA      < 16817.5 to the left,  improve=0.006362978, (0 missing)
##   Surrogate splits:
##       DIA_NOMBRE splits as  LRRRRRL,     agree=0.503, adj=0.005, (0 split)
##       FECHA      < 17069.5 to the left,  agree=0.501, adj=0.001, (0 split)
##       MES        < 4.5     to the left,  agree=0.501, adj=0.001, (0 split)
##       SEMSANTA   splits as  RL,          agree=0.501, adj=0.001, (0 split)
##       DIA        < 30.5    to the right, agree=0.501, adj=0.001, (0 split)
## 
## Node number 14: 1456 observations
##   mean=10.04945, MSE=19.51953 
## 
## Node number 15: 1460 observations,    complexity param=0.03543742
##   mean=17.93151, MSE=55.47065 
##   left son=30 (209 obs) right son=31 (1251 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.35644600, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.04606966, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.02441886, (0 missing)
##       MES        < 1.5     to the left,  improve=0.02016827, (0 missing)
##       SEMSANTA   splits as  RL,          improve=0.01050465, (0 missing)
##   Surrogate splits:
##       MADRE splits as  RL, agree=0.86, adj=0.019, (0 split)
## 
## Node number 26: 4311 observations
##   mean=4.709116, MSE=5.839766 
## 
## Node number 27: 4319 observations,    complexity param=0.01019611
##   mean=7.236397, MSE=12.63988 
##   left son=54 (588 obs) right son=55 (3731 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.15214440, (0 missing)
##       COMUNA     splits as  ----R-RL-------------, improve=0.04021381, (0 missing)
##       FECHA      < 16817.5 to the left,  improve=0.01464768, (0 missing)
##       FESTIVO    splits as  RL, improve=0.01389541, (0 missing)
##       PERIODO    < 2015.5  to the left,  improve=0.01118320, (0 missing)
##   Surrogate splits:
##       MADRE splits as  RL,          agree=0.867, adj=0.020, (0 split)
##       FECHA < 17530.5 to the right, agree=0.864, adj=0.003, (0 split)
## 
## Node number 30: 209 observations
##   mean=7.052632, MSE=7.92546 
## 
## Node number 31: 1251 observations
##   mean=19.749, MSE=40.33828 
## 
## Node number 54: 588 observations
##   mean=3.743197, MSE=4.993576 
## 
## Node number 55: 3731 observations
##   mean=7.78692, MSE=11.61876

y0_tr_2<-mean(acc_agrupado_2$ACCIDENTES[acc_agrupado_2$FECHA<="2017-12-31"])
r0_tr_2<-acc_agrupado_2$ACCIDENTES[acc_agrupado_2$FECHA<="2017-12-31"]-y0_tr_2
R0_tr_2<-mean(r0_tr_2^2)

y_pred_tr_rpart_2<-predict(modelo_rpart_2)
r_tr_rpart_2<-acc_agrupado_2$ACCIDENTES[acc_agrupado_2$FECHA<="2017-12-31"]-y_pred_tr_rpart_2
R_tr_rpart_2<-mean(r_tr_rpart_2^2)
R2_tr_rpart_2<-1-R_tr_rpart_2/R0_tr_2
print(R2_tr_rpart_2)

## [1] 0.7603366

FALTA

Regresar